home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Taifun
/
Taifun 059 (1988-05-15)(Ossowski, Stefan)(DE)(PD).zip
/
Taifun 059 (1988-05-15)(Ossowski, Stefan)(DE)(PD).adf
/
Haushaltssystem
/
HHB V1.2.ascii
< prev
next >
Wrap
Text File
|
1988-04-22
|
66KB
|
2,569 lines
IF FRE(-1) < 110000& THEN
LOCATE 11,20:PRINT "Es ist leider zuwenig Speicher frei !"
GOSUB Mouseclick:SYSTEM
END IF
ON BREAK GOSUB Ende:BREAK ON:ON ERROR GOTO Fehlerdiagnose
SCREEN 2,320,200,3,1
WINDOW 2," Haushaltsbuch ====== Grafikbildschirm ",(0,10)-(311,185),0,2
SCREEN 1,640,200,2,2
WINDOW 1," Haushaltsbuch V 1.2 ============================= Geschrieben von Sauer Franz ",(0,10)-(631,186),16,1
LOCATE 12,26:PRINT "Systemkonfigurierung läuft !"
MOUSE OFF : MENU OFF
GOSUB Farbeinstellung
GOSUB Outoffmemtext
GOSUB Openlibrarys
GOSUB Declarieren
GOSUB Variablendim
GOSUB Systemset
GOSUB Systemsetload
GOSUB Datalesen
GOSUB Cursor
CLS
LOCATE 12,23:PRINT "Ich lese die Haushaltsdaten ein !"
GOSUB Datenein
CLS
LOCATE 12,25:PRINT "Ich lese die Kontenliste ein !"
GOSUB Konteneinlesen
CLS
LOCATE 12,26:PRINT "Ich erstelle die Menüleiste !"
Menuinit:
MENU OFF
FOR x%=1 TO 14:m%(1,x%)=1:m%(2,x%)=1:NEXT
GOSUB Menuleiste1 : GOSUB Menuleiste2
GOSUB Konteneinlesen
GOSUB Machkonten
IF sortflag%=0 THEN MENU 2,8,2:MENU 2,9,1:ELSE:MENU 2,8,1:MENU 2,9,2
IF detailflag%=1 THEN MENU 2,5,1:MENU 2,6,2
IF gesamtflag%=1 THEN MENU 2,5,2:MENU 2,6,1
ON MOUSE GOSUB Mousecheck
ON MENU GOSUB Menuabfrage
CLS
Programmstart:
GOSUB Windowclose3:fakt%=0
GOSUB Tabmaske
GOSUB datum
Menucheck:
IF tagkorflag%=1 OR kontenaktiv%=1 OR fakt%=1 OR printakt%=1 OR mousep%>0 THEN
MENU OFF
ELSE
MENU ON
END IF
MOUSE ON
IF FRE(-1)<23000& THEN GOSUB Outoffmem
SLEEP
IF hlf%=1 THEN
IF INKEY$<>"" THEN tdr=1:GOSUB Mouseposition
END IF
GOTO Menucheck
Menuabfrage:
leiste = MENU(0): punkte = MENU(1)
IF hilfeflag%=1 THEN Hilferoutine
Menuwahl:
MENU OFF: MOUSE OFF
ON leiste GOTO Larbeit,Lausgabe,Kontoakt,Kontoakt,Kontoakt,Kontoakt,Kontoakt
Larbeit:
ON punkte GOTO Tagein,Tagkor,Zeitmaske,datum,Filtertext,Wae,Datenakt,Konten,Sort,Import,Export,Sysst,Hilfe,Autor,Progende
Lausgabe:
ON punkte GOTO Tabausgabe,Tabprint,Nix,Msw2,Msw2,Msw2,Msw2,Msw2,Msw2,Msw2,Kontengrafik,Selektieren,Selinv,Selloe
datum:
windowtext$="Datumeingabe:":GOSUB Openwindow3
GOSUB Datumeingabe
GOSUB Windowclose3
RETURN
Kontoakt:
IF eingmod=1 THEN kl=leiste:kp=punkte:eingmod=0:MENU ON:RETURN
eingmod=3
GOSUB Menurefresh
RETURN
Nix:
RETURN
Tagkor:
tagkorflag%=1
GOSUB Tabausgabe
RETURN
Tagkor1:
IF show%(calcnr%)=0 THEN RETURN
daten$=ds$(show%(calcnr%))
kl=VAL(LEFT$(daten$,1)):kp=VAL(MID$(daten$,2,1))
datumchange=1
datum$=MID$(daten$,4,8)
komentar$=MID$(daten$,24,LEN(daten$)-32)
komentar$=LEFT$(komentar$,40)
betrag$=STR$(VAL(RIGHT$(daten$,10)))
wtext3$="Tagesereignisse ändern:"
WINDOW 3,wtext3$,(80,35)-(550,150),0,1
GOTO Weiter12
Tagein:
MOUSE OFF
IF ml%=0 THEN
fehlertext$="Keine Eintragungen möglich. Konten fehlen !"
GOTO Fehlermeldung
END IF
IF anzahl%>=datenmenge-1 THEN
fehlertext$="Datei voll ! Bitte eine Neue beginnen.":GOTO Fehlermeldung
END IF
wtext3$="Tagesereignisse eintragen:(noch"+STR$(datenmenge-1-anzahl%)+" Eintragungen möglich !)"
WINDOW 3,wtext3$,(80,35)-(550,150),0,1
LOCATE 7,9
PRINT "Bitte ein Konto aus Menuleiste auswählen !"
MENU ON
FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,0
NEXT
MENU 1,0,0:MENU 2,0,0
eingmod=1
WHILE eingmod=1:SLEEP:WEND
IF eingmod=3 THEN
FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,m%(x%,1)+1
NEXT
MENU 1,0,1:MENU 2,0,1
GOTO Windowclose3
END IF
LOCATE 7,9:PRINT SPACE$(50)
LOCATE 2,25
Weiter12:
GOSUB Datumeingabe
IF datum$<dzeitstart$ OR datum$>dzeitende$ THEN Weiter12
GOSUB Wochentagberechnung
CLS
LOCATE 2,11:PRINT "Eintragung für "wt$(wt%)" den "datum$
center=28-(LEN(m$(kl,kp))+40)/2
IF tagkorflag%=0 THEN
IF INSTR(kontoart$(kl,kp),"u")>0 THEN
uekl=kl:uekp=kp
LOCATE 4,center:PRINT"Überweisung vom Konto "m$(kl,kp)" ! Bitte 2.Konto wählen"
MENU ON: eingmod=1: WHILE eingmod=1:SLEEP:WEND
IF eingmod=3 THEN
FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,m%(x%,1)+1
NEXT
MENU 1,0,1:MENU 2,0,1
GOTO Windowclose3
END IF
LOCATE 4,2:PRINT SPACE$(70)
LOCATE 4,center:PRINT"Diese Eingabe wird auf das Konto "m$(kl,kp)" ueberwiesen"
laenge=36:GOTO Weiter3
END IF
END IF
laenge=40
LOCATE 4,center:PRINT"Diese Eingabe wird auf das Konto "m$(kl,kp)" verbucht"
Weiter3:
LOCATE 6,3:PRINT"Kommentar:":LOCATE 6,47:PRINT"Betrag"
LOCATE 8,3
msgs$="":IF tagkorflag%=1 THEN msgs$=komentar$
type%=0:GOSUB Superinput:komentar$=msgs$
IF msgs$="" THEN Weiter16
msgs$=""
IF tagkorflag%=1 THEN msgs$=betrag$
122 LOCATE 8,47:laenge=10
type%=1:GOSUB Superinput:betrag$=msgs$
IF betrag$="" THEN
IF funktion=9 THEN
msgs$=STR$(summe)
ELSE
msgs$=STR$(rechenwert)
END IF
GOTO 122
END IF
IF VAL(betrag$)>=999999! OR VAL(betrag$)<=-999999& THEN
LOCATE 8,47:PRINT SPACE$(10):GOTO 122
END IF
IF tagkorflag%=1 THEN Tagkorbest
ttextrl=12:ttextrp=18:ttextfl=12:ttextfp=35:GOSUB Bestaetigung
mousep%=1:RETURN
Mp1:
mousep%=0
IF fehler=0 THEN
IF VAL(betrag$)=0 THEN
fehlertext$="Beträge von 0.00 "+waehrung$+" sind nicht abspeicherbar !"
GOSUB Geisterkiller:GOTO Fehlermeldung
END IF
GOSUB Abspeichern
END IF
Weiter16:
GOSUB Geisterkiller
GOTO Windowclose3
Geisterkiller:
FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,m%(x%,1)+1
NEXT
MENU 1,0,1:MENU 2,0,1
RETURN
Tagkorbest:
request%=3
ttextrl=12:ttextrp=10:ttextwl=12:ttextwp=25:ttextfl=12:ttextfp=40
GOSUB Bestaetigung:mousep%=2:RETURN
Mp2:
mousep%=0
request%=0
IF fehler=2 THEN GOSUB Eintragen:GOTO Windowclose3
IF fehler=0 THEN
GOSUB Eintragen:GOSUB Windowclose3:GOTO Sort
END IF
tagkorflag%=0:WINDOW OUTPUT 1:GOSUB Listen1:GOTO Windowclose3
Eintragen:
kn$=RIGHT$(STR$(kl*10+kp),2)
ds$(show%(calcnr%))=kn$+" "+datum$+" "+wt$(wt%)+" "+komentar$+" "+betrag$
WINDOW OUTPUT 1:GOSUB Listen1:WINDOW 3
RETURN
Datenakt:
MENU OFF:MOUSE OFF
WINDOW 3,"Dateien Aktualisieren:",(80,50)-(550,140),0,1
PALETTE 3,0,0,0
LOCATE 5,16:PRINT "Bitte Dateinamen eingeben !"
LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b
PAINT (55,51),3
PALETTE 3,r(3),g(3),b(3)
IF dateiname$="" THEN dateiname$="Haushaltsdaten/"
altdn$=dateiname$
LOCATE 8,10:laenge=38:msgs$=dateiname$:GOSUB Superinput:dateiname$=msgs$
diskfehler=0
CLOSE #2
OPEN dateiname$ FOR INPUT AS #2
CLOSE #2
IF diskfehler=2 THEN
diskfehler=0
GOTO Fehlermeldung
END IF
IF diskfehler<1 THEN GOTO Dateiwechsel ' Datei bereits vorhanden
WINDOW 3,"Dateien Aktualisieren:",(80,50)-(550,140),0,1
LOCATE 4,12:PRINT "Ich habe diese Datei nicht gefunden."
LOCATE 6,12:PRINT "Wollen Sie die Datei neu erstellen ?"
ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung
mousep%=3:RETURN
Mp3:
mousep%=0
IF fehler=1 THEN dateiname$=altdn$:GOTO Windowclose3
Machedatei:
CLS
PALETTE 3,0,0,0
LINE (7,36)-(457,52),3,bf
LOCATE 6,3:COLOR 0,3:PRINT "Die Datei soll vom "
LOCATE 6,22:COLOR 1,0:PRINT " "
LOCATE 6,33:COLOR 0,3:PRINT" bis "
LOCATE 6,38:COLOR 1,0:PRINT " "
LOCATE 6,50:COLOR 0,3:PRINT"dauern."
PALETTE 3,r(3),g(3),b(3):COLOR 1,0
fehlerpos=9
Weiter5:
dzeitstart$="86-01-01":dzeitende$="99-12-31"
LOCATE 6,22:laenge=8:msgs$=zeitstart$:type%=1:GOSUB Superinput
zeitstart$=msgs$
checkdat$=dzeitstart$:GOSUB Datumcheck
IF fehler=1 THEN fehler=0:GOTO Weiter5
Weiter6:
LOCATE 6,38:laenge=8:msgs$=zeitende$:type%=1:GOSUB Superinput
zeitende$=msgs$
checkdat$=dzeitende$:GOSUB Datumcheck
IF fehler=1 THEN fehler=0:GOTO Weiter6
IF zeitstart$>=zeitende$ THEN Weiter5
fehler=3
ttextrl=10:ttextrp=20:ttextfl=10:ttextfp=34:GOSUB Bestaetigung
mousep%=4:RETURN
Mp4:
mousep%=0
IF fehler=1 THEN Machedatei
CLS
PALETTE 3,0,0,0
LOCATE 5,9:PRINT "Bitte den Namen der Kontenliste eingeben !"
LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b:PAINT (55,51),3
PALETTE 3,r(3),g(3),b(3)
IF Kontenliste$="" THEN Kontenliste$="Haushaltskonten/"
alkoli$=Kontenliste$
LOCATE 8,10:laenge=38:msgs$=Kontenliste$:GOSUB Superinput
Kontenliste$=msgs$
diskfehler=0
CLOSE #2
OPEN Kontenliste$ FOR INPUT AS #2
CLOSE #2
IF diskfehler=0 THEN Weiter9
fehlertext$="Kontenliste nicht vorhanden ! Bitte erstellen."
dzeitstart$=d0zeitstart$:dzeitende$=d0zeitende$
Kontenliste$=alkoli$:dateiname$=altdn$
GOTO Fehlermeldung
Weiter9:
diskfehler=0:CLOSE #2
OPEN dateiname$ FOR OUTPUT AS#2
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Weiter9
PRINT #2,"00 "zeitstart$" "zeitende$" "Kontenliste$
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Weiter9
CLOSE #2
Dateiwechsel:
WINDOW 3,"Dateiwechsel:",(80,50)-(550,140),0,1
CLS:LOCATE 6,17:PRINT "Lese Daten, bitte Geduld !"
GOSUB Datenein
CLOSE #2
IF diskfehler>0 THEN Windowclose3
diskfehler=0
Kontenliste$=LEFT$(RIGHT$(ds$(0),LEN(ds$(0))-21),36)
center=19-LEN(Kontenliste$)/2
windowtext$="Dateiwechsel:":GOSUB Openwindow3
LOCATE 6,center:PRINT "Lese Kontenliste "Kontenliste$" ein !"
OPEN Kontenliste$ FOR INPUT AS #2
CLOSE #2
IF diskfehler>0 THEN
fehlertext$="Erforderliche Kontenliste nicht vorhanden !"
Kontenliste$=alkoli$
GOTO Fehlermeldung
END IF
GOSUB Konteneinlesen
GOSUB Machkonten
GOSUB Windowclose3
GOSUB Tabmaske
RETURN
Abspeichern:
diskfehler=0:CLOSE #2
OPEN dateiname$ FOR APPEND AS #2
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Abspeichern
IF diskfehler>0 THEN
fehlertext$="Kann nicht Abspeichern. Keine Datei aktuallisiert !"
GOTO Fehlermeldung
END IF
IF INSTR(kontoart$(kl,kp),"-")>0 THEN neg$="-" ELSE neg$=""
daten$=RIGHT$(STR$(kl*10+kp),2)+" "+datum$+" "+wt$(wt%)+" "+komentar$+" "+neg$+betrag$
anzahl%=anzahl%+1
ds$(anzahl%)=RIGHT$(daten$,LEN(daten$))
PRINT#2,daten$
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Abspeichern
IF INSTR(kontoart$(uekl,uekp),"u")>0 THEN
IF INSTR(kontoart$(uekl,uekp),"-")>0 THEN neg$="-":ELSE:neg$=""
daten$=RIGHT$(STR$(uekl*10+uekp),2)+" "+datum$+" "+wt$(wt%)+" (U) "+komentar$+" "+neg$+betrag$
PRINT#2,daten$
uekl=0:uekp=0
anzahl%=anzahl%+1
ds$(anzahl%)=RIGHT$(daten$,LEN(daten$))
END IF
CLOSE#2
RETURN
Tabausgabe:
WINDOW 1:GOSUB Tabkopf
LINE (36,22)-(625,151),0,bf:LINE(8,36)-(27,138),0,bf
tabaktuell=1:tabaktiv=1
LOCATE 11,23:PRINT"Bitte etwas Geduld ich suche Daten !"
IF filterflag%=1 THEN
LOCATE 13,23:PRINT"Achtung !!!!! Filterfunktion aktiv ."
END IF
IF sortflag%=0 THEN GOSUB Kontenliste
gesamtbe=0
z%=0 :bildzeilen=16
gesamtakt%=0
ERASE show$,show%,calc%:DIM show$(30),show%(datenmenge),calc%(datenmenge)
IF tagkorflag%=1 THEN GOSUB Suchrutine2:GOTO Weiter4
IF monatflag%=1 THEN gesamtakt%=1:GOSUB Suchrutine4:GOTO Weiter4
IF gesamtflag%=1 THEN gesamtakt%=1:GOSUB Suchrutine3:GOTO Weiter4
IF sortflag%=0 THEN GOSUB Suchrutine1
IF sortflag%=1 THEN GOSUB Suchrutine2
Weiter4:
LOCATE 11,20:PRINT SPACE$(40)
LOCATE 13,20:PRINT SPACE$(40)
GOSUB Berechnung :IF z%=0 THEN RETURN
prozent%=bildzeilen/(z%/100):IF prozent%>100 THEN prozent%=100
LINE(10,37)-(25,37+prozent%),2,bf:GET(10,37)-(25,37+prozent%),balken%
mitte=prozent%/2:x=10:yx=37:showstart=1
LOCATE 12,20:PRINT SPACE$(40)
GOTO Listen1
Suchrutine1:
z%=0
FOR y%=0 TO klg%
FOR x%=1 TO anzahl%
IF koliste%(y%)=VAL(LEFT$(ds$(x%),2)) THEN
d$= MID$(ds$(x%),4,8)
IF zeitstart$=<d$ AND zeitende$>=d$ THEN
IF filterflag%=1 THEN
IF INSTR(ds$(x%),Filtertext$)>0 THEN
z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10))
gesamtbe=gesamtbe+w
END IF
ELSE
z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10))
gesamtbe=gesamtbe+w
END IF
END IF
END IF
NEXT x%,y%
RETURN
Suchrutine2:
z%=0
FOR x%=1 TO anzahl%
x1%= VAL(LEFT$(ds$(x%),1))
y1%= VAL(MID$(ds$(x%),2,1))
IF m%(x1%,y1%)=1 THEN
d$= MID$(ds$(x%),4,8)
IF zeitstart$=<d$ AND zeitende$>=d$ THEN
IF filterflag%=1 THEN
IF INSTR(ds$(x%),Filtertext$)>0 THEN
z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10))
gesamtbe=gesamtbe+w
END IF
ELSE
z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10))
gesamtbe=gesamtbe+w
END IF
END IF
END IF
NEXT
RETURN
Suchrutine3:
ERASE gges:DIM gges(7,6)
FOR x%=1 TO anzahl%
gh%=VAL(LEFT$(ds$(x%),1)):gu%=VAL(MID$(ds$(x%),2,1))
IF m%(gh%,gu%)=1 THEN
d$= MID$(ds$(x%),4,8)
IF zeitstart$=<d$ AND zeitende$>=d$ THEN
IF filterflag%=1 THEN
IF INSTR(ds$(x%),Filtertext$)>0 THEN
w=VAL(RIGHT$(ds$(x%),10)):gges(gh%,gu%)=gges(gh%,gu%)+w
gesamtbe=gesamtbe+w:knum$(y%)=LEFT$(ds$(x%),2)
END IF
ELSE
w=VAL(RIGHT$(ds$(x%),10)):gges(gh%,gu%)=gges(gh%,gu%)+w
gesamtbe=gesamtbe+w:knum$(y%)=LEFT$(ds$(x%),2)
END IF
END IF
END IF
NEXT x%
z%=0
GOSUB Wochentagberechnung
FOR y%=3 TO 7
FOR x%=1 TO 6
IF gges(y%,x%)<>0 THEN
z%=z%+1
show$(z%)=RIGHT$(STR$(y%),1)+RIGHT$(STR$(x%),1)+" "+datum$
show$(z%)=show$(z%)+" "+wt$(wt%)+" "+m$(y%,x%)+" Gesamt "
show$(z%)=show$(z%)+zeitstart$+" bis "+zeitende$
show$(z%)=show$(z%)+" "+STR$(gges(y%,x%))
END IF
NEXT x%,y%
RETURN
Suchrutine4:
jahre%=0
FOR x%=VAL(LEFT$(zeitstart$,2)) TO VAL(LEFT$(zeitende$,2))
jahre%=jahre%+1
NEXT
IF jahre%>4 THEN RETURN
ERASE show$:DIM show$(12+(jahre%*12))
ERASE mges:DIM mges(jahre%-1,12)
FOR x%=1 TO anzahl%
IF m%(VAL(LEFT$(ds$(x%),1)),VAL(MID$(ds$(x%),2,1)))=1 THEN
d$= MID$(ds$(x%),4,8)
IF zeitstart$=<d$ AND zeitende$>=d$ THEN
IF filterflag%=1 THEN
IF INSTR(ds$(x%),Filtertext$)>0 THEN
w=VAL(RIGHT$(ds$(x%),10))
mon%=VAL(MID$(d$,4,2)):jahr%=VAL(LEFT$(d$,2))-VAL(LEFT$(zeitstart$,2))
mges(jahr%,mon%)=mges(jahr%,mon%)+w
gesamtbe=gesamtbe+w
END IF
ELSE
w=VAL(RIGHT$(ds$(x%),10))
mon%=VAL(MID$(d$,4,2)):jahr%=VAL(LEFT$(d$,2))-VAL(LEFT$(zeitstart$,2))
mges(jahr%,mon%)=mges(jahr%,mon%)+w
gesamtbe=gesamtbe+w
END IF
END IF
END IF
NEXT x%
z%=0
GOSUB Wochentagberechnung
FOR x%=0 TO jahre%-1
FOR y%=1 TO 12
IF mges(x%,y%)<>0 THEN
z%=z%+1
show$(z%)="00 "+datum$+" "+wt$(wt%)+" Monatliche Abrechnung für "
show$(z%)=show$(z%)+monat$(y%)+STR$(VAL(LEFT$(zeitstart$,2))+x%)
show$(z%)=show$(z%)+" "+STR$(mges(x%,y%))
END IF
NEXT y%,x%
RETURN
Filtertext:
WINDOW 3,"Daten Filter",(50,55)-(580,123),0,1
meldung$="Bitte Text nach dem du suchen willst eingeben !"
center=34-(LEN(meldung$)/2)
LOCATE 2,center :PRINT meldung$
LINE (60,19)-(470,36),3,b:LINE(70,21)-(460,34),3,b:PAINT (62,25),3
LOCATE 4,11:laenge=40:msgs$=Filtertext$
type%=0:GOSUB Superinput:Filtertext$=msgs$
IF Filtertext$="" THEN Windowclose3
ttextrl=7:ttextrp=23:ttextfl=7:ttextfp=40:GOSUB Bestaetigung
mousep%=5:RETURN
Mp5:
mousep%=0
IF fehler=1 THEN Filtertext$=""
GOTO Windowclose3
Selektieren:
x%=0 :ok%=0
WHILE x%<=z%
x%=x%+1
IF calc%(x%)=1 THEN ok%=1
WEND
IF ok%=0 THEN
fehlertext$="Ich habe keine Selektierten Daten gefunden !"
GOTO Fehlermeldung
END IF
LINE (36,22)-(625,151),0,bf:LINE(8,36)-(27,138),0,bf
LOCATE 11,23:PRINT"Bitte Geduld ich selektiere Daten !"
selektflag=1
sz%=1:gesamtbe=0
FOR x%=1 TO z%
IF gesamtakt%=0 THEN
IF calc%(x%)=1 THEN
show%(sz%)=show%(x%)
gesamtbe=gesamtbe+VAL(RIGHT$(ds$(show%(x%)),10))
sz%=sz%+1
END IF
END IF
IF gesamtakt%=1 THEN
IF calc%(x%)=1 THEN
show$(sz%)=show$(x%)
gesamtbe=gesamtbe+VAL(RIGHT$(show$(x%),10))
sz%=sz%+1
END IF
END IF
NEXT
IF gesamtakt%=0 THEN
FOR x%=sz% TO z%:show%(x%)=0:NEXT:z%=sz%-1
ELSE
FOR x%=sz% TO z%:show$(x%)="":NEXT:z%=sz%-1
END IF
ERASE calc% :DIM calc%(datenmenge)
GOTO Weiter4
Selloe:
ERASE calc%:DIM calc%(datenmenge)
GOSUB Listen1
RETURN
Selinv:
FOR x%=1 TO z%:calc%(x%)=1-calc%(x%):NEXT
GOSUB Listen1
RETURN
Listen:
showstart=INT((yx-37)*(z%/100))
IF showstart<1 OR yx<39 THEN showstart=1
IF prozent%<100 THEN
IF yx+prozent%>136 THEN showstart=z%-(bildzeilen-1)
END IF
Listen1:
MOUSE OFF
LINE(35,22)-(626,151),0,bf:calcpos%=0
FOR calcnr%=showstart TO showstart+bildzeilen-1
GOSUB Listenprint
calcpos%=calcpos%+1
NEXT
summe=0:rechenwert=gesamtbe:calcmodus%=1
RETURN
Listenprint:
IF calc%(calcnr%)=1 THEN COLOR 2:ELSE COLOR 1
LOCATE 4+calcpos%,6
IF gesamtakt%=0 THEN
IF show%(calcnr%)<>0 THEN
rechenwert=VAL(RIGHT$(ds$(show%(calcnr%)),10))
texti$=MID$(ds$(show%(calcnr%)),3,LEN(ds$(show%(calcnr%)))-12)
CALL Text (WINDOW(8),SADD(texti$),LEN(texti$))
LOCATE 4+calcpos%,68:PRINT USING "#######.##";rechenwert
END IF
ELSE
IF show$(calcnr%)<>"" THEN
rechenwert=VAL(RIGHT$(show$(calcnr%),10))
texti$=MID$(show$(calcnr%),3,LEN(show$(calcnr%))-12)
CALL Text (WINDOW(8),SADD(texti$),LEN(texti$))
LOCATE 4+calcpos%,68:PRINT USING "#######.##";rechenwert
END IF
END IF
COLOR 1
RETURN
Korrbalken:
PUT (10,yx),balken%
yx=(showstart-1)/z%*100+37
PUT (10,yx),balken%
RETURN
Scrolldown:
IF showstart<=1 THEN RETURN
showstart=showstart-1
GOSUB Korrbalken
calcpos%=0:calcnr%=showstart
SCROLL (36,24)-(625,151),0,8
GOSUB Listenprint
RETURN
Scrollup:
IF showstart+bildzeilen-1>=z% THEN RETURN
showstart=showstart+1
GOSUB Korrbalken
calcpos%=bildzeilen-1:calcnr%=showstart+bildzeilen-1
SCROLL (36,24)-(625,151),0,-8
GOSUB Listenprint
RETURN
Mousecheck:
MENU OFF:x=MOUSE(0)
IF ed%=1 THEN Mcp
IF kontenaktiv%=1 THEN Kontenmousecheck
IF mousep%>0 THEN Mouseposition
IF fakt%=1 THEN fakt%=0:GOTO Windowclose3
IF hilfeflag%=1 THEN hilfeflag%=0:MOUSE STOP :GOTO Windowclose3
IF WINDOW(0)=1 AND tabaktiv<>0 THEN
WINDOW 1
IF MOUSE(1)>10 AND MOUSE(1)<25 AND MOUSE(2)>37 AND MOUSE(2)<137 THEN GOSUB Showzoom:GOTO Listen
Scrollrepeat:
IF MOUSE(3)>10 AND MOUSE(3)<25 THEN
IF MOUSE(4)>27 AND MOUSE(4)<37 THEN GOSUB Scrolldown
IF MOUSE(4)>137 AND MOUSE(4)<147 THEN GOSUB Scrollup
IF MOUSE(0)=-1 THEN Scrollrepeat
RETURN
END IF
IF MOUSE(2)>157 AND MOUSE(2)<171 THEN Rechnerfunktion
IF MOUSE(2)>=24 AND MOUSE(2)<=150 AND MOUSE(1)>40 AND MOUSE(1)<620 THEN Rechner
END IF
IF WINDOW(0)=2 AND grafikaktiv%=1 THEN
WINDOW 2
MOUSE STOP:GOTO Grafikselekt
END IF
RETURN
Rechnertasten:
COLOR 0,1
LOCATE 21,3:PRINT "ALT" :LOCATE 21,10:PRINT "CE":LOCATE 21,16:PRINT "IN"
LOCATE 21,22:PRINT "OUT":LOCATE 21,29:PRINT "+":LOCATE 21,35:PRINT "-";
PRINT PTAB(324)"*":LOCATE 21,48:PRINT "/":LOCATE 21,54:PRINT "="
COLOR 1,0
LOCATE 21,58:PRINT "Gesamt "waehrung$
RETURN
Berechnung:
LOCATE 21,68:PRINT USING "#######.##";gesamtbe:rechenwert=gesamtbe
IF tabaktuell=2 OR z%<>0 THEN RETURN
tagkorflag%=0
fehlertext$="Ich habe leider keine Daten gefunden"
IF jahre%>4 THEN jahre%=0:fehlertext$="Monatsabrechnungen können nur über 4 Jahre gehen !"
GOTO Fehlermeldung
Showzoom:
IF MOUSE(0)<=-1 THEN Weiter2
IF MOUSE(0)=0 THEN RETURN
GOTO Showzoom
Weiter2:
IF MOUSE(1)< 0 OR MOUSE(1)>100 THEN Showzoom
IF ABS(yx-(MOUSE(2)-mitte)) < 1 THEN Showzoom
GOSUB Movebalken
GOTO Showzoom
Movebalken:
PUT(10,yx),balken%
yx=MOUSE(2)-mitte
IF MOUSE(2)-mitte<37 THEN yx=37
IF MOUSE(2)+mitte>137 THEN yx=137-mitte*2
PUT(10,yx),balken%
RETURN
Datumeingabe:
LOCATE 9,20:PRINT SPACE$(20)
LOCATE 6,10:PRINT"Bitte Datum im Format JJ-MM-TT eingeben"
LOCATE 7,32:laenge=8:msgs$=datum$:type%=1
GOSUB Superinput:datum$=msgs$
IF datum$="" THEN fehler=3 :RETURN
fehlerpos=9:checkdat$=datum$
GOSUB Datumcheck:datum$=checkdat$
IF fehler=1 THEN fehler=0 :GOTO Datumeingabe
LOCATE 6,10:PRINT SPACE$(40)
LOCATE 7,30:PRINT SPACE$(20)
GOSUB Wochentagberechnung
MENU 1,4,1,"Datum ändern ("+datum$+") "
RETURN
Wochentagberechnung:
jj=1900+VAL(LEFT$(datum$,2)):mm=VAL(MID$(datum$,4,2)):tt=VAL(RIGHT$(datum$,2))
IF mm<3 THEN smj=(366+mm)-(INT(365.25*jj)-INT(365.25*(jj-1))):ELSE:smj=0
sj=INT(365.25*jj)-INT(jj/100)+INT(jj/400)+31*(mm-1)-INT(.4*mm+2.3-smj)+tt
jj=sj+1721060&:wt%=jj-INT(jj/7)*7
RETURN
Menuleiste1:
MENU 1,0,1,"Arbeit"
MENU 1,1,1,"Tagesereignisse eingeben"
MENU 1,2,1,"Tagesereignisse ändern "
MENU 1,3,1,"Zeitmaske eingeben "
MENU 1,4,1,"Datum ändern ("+datum$+") "
MENU 1,5,1,"Filtertext eingeben "
MENU 1,6,1,"Währungszeichen ändern "
MENU 1,7,1,"Dateien verwalten "
MENU 1,8,1,"Kontenlisten verwalten "
MENU 1,9,1,"Daten sortieren "
MENU 1,10,1,"Daten importieren "
MENU 1,11,1,"Daten exportieren "
MENU 1,12,1,"Systemstatus "
MENU 1,13,1,"Hilfe ( Beschreibung ) "
MENU 1,14,1,"Autor !!!!!!!!!!!!!!!!! "
MENU 1,15,1,"Programm beenden "
RETURN
Menuleiste2:
MENU 2,0,1,"Ausgabe"
MENU 2,1,m%(2,1), "Tabelle Bildschirm "
MENU 2,2,m%(2,2), "Tabelle Drucken "
MENU 2,3,m%(2,3), "====================="
MENU 2,4,m%(2,4), " Alle Konten AN/AUS "
MENU 2,5,m%(2,5), " Gesamt "
MENU 2,6,m%(2,6), " Detailiert "
MENU 2,7,m%(2,7), " Filter EIN/AUS "
MENU 2,8,m%(2,8), " Sortiert n. Konten "
MENU 2,9,m%(2,9), " Sortiert n. Datum "
MENU 2,10,m%(2,10)," Monatsabrechnung "
MENU 2,11,m%(2,11),"Grafikausgabe "
MENU 2,12,m%(2,12),"Selektieren "
MENU 2,13,m%(2,13),"Selekt invertieren "
MENU 2,14,m%(2,14),"Selekt löschen "
RETURN
Machkonten:
allkonflag%=0:MENU 2,4,1
FOR x%=3 TO 7:MENU x%,0,0,"":NEXT
FOR leiste=3 TO ml%+2 :MENU leiste,0,1,m$(leiste,1)
MENU leiste,1,m%(leiste,1)+1," "+LEFT$(m$(leiste,1)+" ",9)
FOR x%=2 TO ma%(leiste)
MENU leiste,x%,m%(leiste,x%)+1," "+LEFT$(m$(leiste,x%)+" ",9)
NEXT x%,leiste
RETURN
Msw2:
IF punkte=5 THEN
gesamtflag%=1:detailflag%=0:monatflag%=0
MENU 2,5,2:MENU 2,6,1:MENU 2,10,1
END IF
IF punkte=6 THEN
detailflag%=1:gesamtflag%=0:monatflag%=0
MENU 2,5,1:MENU 2,6,2:MENU 2,10,1
END IF
IF punkte=10 THEN
monatflag%=1:gesamtflag%=0:detailflag%=0
MENU 2,10,2:MENU 2,6,1:MENU 2,5,1
END IF
IF punkte=8 THEN sortflag%=0:MENU 2,8,2:MENU 2,9,1
IF punkte=7 THEN filterflag%=1-filterflag%:MENU 2,7,filterflag%+1
IF punkte=9 THEN sortflag%=1:MENU 2,8,1:MENU 2,9,2
IF punkte=4 THEN
allkonflag%=1-allkonflag%:tabaktuell=2-allkontenflag%*2:MENU 2,4,allkonflag%+1
tabaktuell=0
FOR x%=3 TO ml%+2
FOR y%=1 TO ma%(x%)
IF m$(x%,y%)<>"" THEN m%(x%,y%)=allkonflag%:MENU x%,y%,allkonflag%+1
NEXT y%,x%
END IF
RETURN
Menurefresh:
tabaktuell=0
IF punkte<2 THEN
m%(leiste,1)=1-m%(leiste,1)
FOR x%=1 TO ma%(leiste)
m%(leiste,x%)=m%(leiste,1)
IF m$(leiste,x%)<>"" THEN MENU leiste,x%,m%(leiste,x%)+1
NEXT
ELSE:
m%(leiste,punkte)=1-m%(leiste,punkte)
IF m$(leiste,punkte)<>"" THEN MENU leiste,punkte,m%(leiste,punkte)+1
END IF
RETURN
Kontenliste:
ERASE koliste%:ERASE koliste$:DIM koliste$(30):DIM koliste%(30)
klg%=0
FOR x%=3 TO ml%+2:FOR y%=2 TO ma%(x%)
IF m%(x%,y%)=1 THEN
klg%=klg%+1
koliste$(klg%)=m$(x%,y%)
koliste%(klg%)=x%*10+y%
END IF
NEXT y%,x%
RETURN
Zeitmaske:
WINDOW 3,"Zeitmaske eingeben",(80,35)-(550,150),0,1
LOCATE 3,8:PRINT "Aktuelle Zeitmaske von "zeitstart$" bis "zeitende$"
1200 fehler=0: LOCATE 6,14:PRINT "Ausgaben vom (JJ-MM-TT) ";
laenge=8:msgs$=zeitstart$:type%=1:GOSUB Superinput :checkdat$=msgs$
IF checkdat$="" THEN Windowclose3
fehlerpos=10:GOSUB Datumcheck
IF fehler=1 THEN GOTO 1200
zeitstart$=msgs$
1201 fehler=0: LOCATE 8,23:PRINT "bis (JJ-MM-TT) ";
laenge=8:msgs$=zeitende$:type%=1:GOSUB Superinput :checkdat$=msgs$
IF checkdat$="" THEN Windowclose3
fehlerpos=10:GOSUB Datumcheck
IF fehler=1 THEN GOTO 1201
zeitende$=msgs$
ttextrl=12:ttextrp=18:ttextfl=12:ttextfp=35:GOSUB Bestaetigung
mousep%=6:RETURN
Mp6:
mousep%=0
IF fehler=1 THEN GOTO Zeitmaske
WINDOW 1:GOSUB Tabkopf
GOSUB Systemsetsave
GOTO Windowclose3
Datumcheck:
jj$=(LEFT$(checkdat$,2)):mm$=(MID$(checkdat$,4,2)):tt$=(RIGHT$(checkdat$,2))
jj=VAL(jj$):mm=VAL(mm$):tt=VAL(tt$)
IF LEN(checkdat$)>8 OR LEN(checkdat$)<8 THEN Datumfehler
IF MID$(checkdat$,3,1)<> "-" OR MID$(checkdat$,6,1)<> "-" THEN Datumfehler
IF checkdat$<dzeitstart$ OR checkdat$>dzeitende$ THEN Datumfehler
IF jj<80 OR jj>99 THEN Datumfehler
IF mm<1 OR mm>12 THEN Datumfehler
IF tt<1 OR tt>31 THEN Datumfehler
RETURN
Datumfehler:
fehler =1
LOCATE fehlerpos,5:PRINT SPACE$(40)
LOCATE fehlerpos,24:PRINT"Datum falsch"
FOR x=1 TO 1000:NEXT
LOCATE fehlerpos,24:PRINT SPACE$(13)
RETURN
Mouseclick:
MOUSE OFF
dummy=MOUSE(0)
WHILE MOUSE(0)<>-1:SLEEP:WEND
dummy=MOUSE(3):dummy=MOUSE(3)
MOUSE ON
RETURN
Ende:
GOSUB Windowclose3:CLS:LIBRARY CLOSE:END
Progende:
windowtext$="Programm beenden :":GOSUB Openwindow3
LOCATE 4,25:PRINT "Good bye !"
ttextrl=7:ttextrp=18:ttextfl=7:ttextfp=35:GOSUB Bestaetigung
mousep%=7:RETURN
Mp7:
mousep%=0
IF fehler=0 THEN Ende
GOTO Windowclose3
Operationsmeldung:
WINDOW CLOSE 3
WINDOW 3,"Operationsmeldung",(122,80)-(512,118),0,1
center=25-(LEN(operationstext$)/2)
LOCATE 3,center :PRINT operationstext$
IF flag=1 THEN flag=0:RETURN
GOSUB Mouseclick
GOTO Windowclose3
Fehlermeldung:
SOUND 1500,2,255,3:fakt%=1
WINDOW 3,"Fehlerdiagnose",(82,80)-(552,120),0,1
center1=1
center=30-(LEN(fehlertext$)/2)
IF fehlertext1$<>"" THEN center1=30-(LEN(fehlertext1$)/2)
LOCATE 3,center :COLOR 2:PRINT fehlertext$:COLOR 1
LOCATE 4,center1:COLOR 2:PRINT fehlertext1$:COLOR 1
fehlertext1$="":fehlertext$=""
fehlerflag=1
IF diskfehler=4 THEN GOSUB Mouseclick
RETURN
Fehlerdiagnose:
IF ERR=61 THEN
fehlertext$="Diskette voll ! Bitte auf DIESER Platz schaffen !"
diskfehler=4
RESUME NEXT
END IF
IF ERR=70 THEN
fehlertext$="Ihre Diskette ist schreibgeschützt."
fehlertext1$="Bitte Schreibschutz entfernen !"
diskfehler=4
RESUME NEXT
END IF
IF ERR=53 THEN
fehlertext$="Ich kann diese Datei nicht finden !"
diskfehler=1:RESUME NEXT
END IF
IF ERR=68 THEN
fehlertext$="Mit dem Drucker stimmt etwas nicht !"
druckfehler=1
RESUME NEXT
END IF
IF ERR=6 OR ERR=68 OR ERR=11 OR ERR=58 THEN RESUME NEXT
IF ERR=57 THEN RESUME Windowclose3
IF ERR=23 OR ERR=15 THEN
fehlertext$="Schadhafte Datei ! (Korrigieren mit 'Ed')"
GOSUB Fehlermeldung
diskfehler=2
RESUME Windowclose3
END IF
IF ERR=64 THEN
fehlertext$="Falscher Dateiname !"
GOSUB Fehlermeldung
diskfehler=1:CLOSE #2
RESUME NEXT
END IF
IF ERR=5 OR ERR=52 THEN
diskfehler=2:CLOSE #2
fehlertext$="Falsche Dateinummer"
RESUME NEXT
END IF
IF ERR=55 THEN CLOSE #2:CLOSE #3:RESUME NEXT
IF ERR=14 OR ERR=7 THEN RESUME Outoffmem
ON ERROR GOTO 0
Tabmaske:
GOSUB Screendown
CLS
LINE(3,21)-(32,152),3,b:LINE(4,21)-(31,152),3,b
FOR x=1 TO 2
LINE(5-x,5-x)-(625+x,17+x),3,b
LINE(5-x,156-x)-(625+x,170+x),3,b
LINE(33+x,21)-(625+x,152),3,b
NEXT
y=158:y1=168:FOR x=10 TO 410 STEP 50
LINE(x,y)-(x+35,y1),1,bf:LINE (x,y)-(x+35,y1),3,b:LINE(x+1,y)-(x+34,y1),3,b
NEXT
LINE(7,35)-(28,139),3,b:PAINT(6,33),1,3
LINE(15,31)-(21,34),0,bf:LINE(11,31)-(18,28),0:LINE -(25,31),0:LINE -(11,31),0
LINE(15,140)-(21,143),0,bf:LINE(11,143)-(18,146),0:LINE -(25,143),0:LINE -(11,143),0
PAINT(18,30),0:PAINT(18,144),0
tabaktiv=1
GOSUB Rechnertasten
GOSUB Tabkopf
GOSUB Bildein
GOSUB Screenup
RETURN
Tabkopf:
LOCATE 2,3:PRINT dateiname$
LOCATE 2,37:PRINT "Aktuelle Zeitmaske: "zeitstart$" bis "zeitende$
RETURN
Bildein:
speed=10
FOR y%=speed TO 1 STEP-1
FOR x%=0 TO 7
PALETTE x%,r(x%)/y%,g(x%)/y%,b(x%)/y%
NEXT x%,y%
RETURN
Bildaus:
speed=1000
FOR y%=1 TO speed STEP 100
FOR x%=0 TO 7
PALETTE x%,r(x%)/y%,g(x%)/y%,b(x%)/y%
NEXT x%,y%
RETURN
Rechner:
calcpos%=INT((MOUSE(2)-24)/8)
calcnr%=showstart+calcpos%:calc%(calcnr%)=1-calc%(calcnr%)
IF tagkorflag%=1 THEN Tagkor1
GOSUB Listenprint
GOSUB Summenprint
RETURN
Summenprint:
IF rechenwert<-999999& OR rechenwert>9999999& THEN fehler=1
IF summe<-999999& OR summe>9999999& THEN fehler=1
IF fehler=1 THEN
LOCATE 21,68:PRINT SPACE$(10):LOCATE 21,71 :PRINT "ERROR" :fehler=0
IF funktion<10 THEN y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),3,b
summe=0:rechenwert=0
RETURN
END IF
IF calcmodus%<>0 THEN
LOCATE 21,68:PRINT USING "#######.##";rechenwert
ELSE
LOCATE 21,68:PRINT USING "#######.##";summe
END IF
RETURN
Rechnerfunktion:
funktion=INT((MOUSE(1)-5)/50+1)
IF funktion>9 THEN
LOCATE 21,68:PRINT SPACE$(10):LOCATE 21,68:laenge=10
type%=1:msgs$="":GOSUB Superinput
rechenwert=VAL(msgs$)
IF calcmodus%=0 THEN calcmodus%=1
GOSUB Summenprint
RETURN
END IF
IF funktion<10 THEN
y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),2,b
END IF
IF funktion=1 THEN rechenwert=gesamtbe:GOSUB Summenprint:GOTO Weiter29
IF funktion=2 THEN Loeschen
IF funktion=3 THEN
IF calcmodus%<>0 THEN speicherwert=rechenwert:ELSE:speicherwert=summe
END IF
IF funktion=4 THEN rechenwert=speicherwert:GOSUB Summenprint:GOTO Weiter29
IF funktion<10 THEN
IF calcmodus%=1 THEN summe=summe+rechenwert
IF calcmodus%=2 THEN summe=summe-rechenwert
IF calcmodus%=3 THEN summe=summe*rechenwert
IF calcmodus%=4 THEN
IF rechenwert=0 THEN
fehler=1 :GOSUB Summenprint :RETURN
END IF
summe=summe/rechenwert
END IF
rechenwert=0
calcmodus%=0
GOSUB Summenprint
END IF
IF funktion>4 AND funktion<9 THEN calcmodus%=funktion-4
Weiter29:
IF funktion<10 THEN
y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),3,b
END IF
RETURN
Loeschen:
calcmodus%=1
IF funktion<9 THEN
y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),3,b
END IF
rechenwert=0:summe=0:GOSUB Summenprint
RETURN
Superinput:
WHILE INKEY$<>"":WEND
GOSUB Spacekiller
msgs$=LEFT$(msgs$,laenge)
GOSUB Editor
GOSUB Spacekiller
type%=0
RETURN
Spacekiller:
IF msgs$=" " OR msgs$="" THEN msgs$="":RETURN
WHILE MID$(msgs$,LEN(msgs$),1)=" " AND LEN(msgs$)>1
msgs$=LEFT$(msgs$,LEN(msgs$)-1)
WEND
RETURN
Bestaetigung:
MOUSE OFF
IF request%=3 THEN LOCATE ttextwl,ttextwp:COLOR 1:PRINT"Weiter"
LOCATE ttextrl,ttextrp:COLOR 1:PRINT"Richtig":
LOCATE ttextfl,ttextfp:COLOR 2:PRINT"Falsch":COLOR 1
IF request%=3 THEN txwpos%=ttextwp*8-22:tywpos%=ttextwl*8-13
txrpos%=ttextrp*8-19:tyrpos%=ttextrl*8-13
txfpos%=ttextfp*8-22:tyfpos%=ttextfl*8-13
IF request%=3 THEN
LINE(txwpos%,tywpos%)-(txwpos%+75,tywpos%+17),3,b
LINE(txwpos%+4,tywpos%+2)-(txwpos%+71,tywpos%+15),3,b
END IF
LINE(txrpos%,tyrpos%)-(txrpos%+75,tyrpos%+17),3,b
LINE(txrpos%+4,tyrpos%+2)-(txrpos%+71,tyrpos%+15),3,b
LINE(txfpos%,tyfpos%)-(txfpos%+75,tyfpos%+17),3,b
LINE(txfpos%+4,tyfpos%+2)-(txfpos%+71,tyfpos%+15),3,b
RETURN
Mouseposition:
fehler=3:IF hlf%=1 THEN Weiter27
xpos=MOUSE(3): ypos=MOUSE(4)
IF request%=3 THEN
IF xpos>txwpos% AND xpos<txwpos%+75 AND ypos>tywpos% AND ypos<tywpos%+17 THEN fehler=2
END IF
IF xpos>txrpos% AND xpos<txrpos%+75 AND ypos>tyrpos% AND ypos<tyrpos%+17 THEN fehler=0
IF xpos>txfpos% AND xpos<txfpos%+75 AND ypos>tyfpos% AND ypos<tyfpos%+17 THEN fehler=1
IF request%=3 AND fehler=2 THEN PAINT(txwpos%+2,tywpos%+2),1,3
IF fehler=0 THEN PAINT(txrpos%+2,tyrpos%+2),1,3
IF fehler=1 THEN PAINT(txfpos%+2,tyfpos%+2),2,3
IF fehler=3 OR kontenaktiv%=1 THEN RETURN
Weiter27:
ON mousep% GOTO Mp1,Mp2,Mp3,Mp4,Mp5,Mp6,Mp7,Mp8,Mp9,Mp10,Mp11,Mp12,Mp13,Mp14,Mp15,Mp16,Mp17,Mp18
Sort:
MOUSE OFF:MENU OFF
WINDOW 3,"Daten sortieren",(50,50)-(580,100),0,1
meldung$="Du willst nun die Datei "+MID$(dateiname$,16,16)+" sortieren !"
center=33-(LEN(meldung$)/2)
LOCATE 2,center :PRINT meldung$
ttextrl=5:ttextrp=23:ttextfl=5:ttextfp=40:GOSUB Bestaetigung
mousep%=8:RETURN
Mp8:
mousep%=0
IF fehler=1 AND tagkorflag%=0 THEN Windowclose3
IF fehler=1 THEN Weiter17
operationstext$="Ich sortiere nun die Daten ! Bitte Geduld !"
flag=1:GOSUB Operationsmeldung
GOSUB Bubblesort
Weiter17:
operationstext$="Ich speichere nun die Daten !"
flag=1:GOSUB Operationsmeldung
GOSUB Rueckschreiben:GOSUB Windowclose3
GOSUB Tabmaske
IF tagkorflag%=1 THEN tagkorflag%=0
GOTO Tabausgabe
Vertikaltext:
Text1:
DATA 1,2,3,4,5
Text2:
DATA S,E,L,E,K,T
Text3:
DATA C,L,E,A,R
Text4:
DATA C,E
Kontengrafik:
WINDOW 2
grafikaktiv%=1
GOSUB Bildaus
f=5:zoom%=0
COLOR 4,0:CLS
LINE(0,0)-(311,175),f,b:LINE(1,1)-(310,174),f,b
LINE(0,19)-(310,20),f,b:LINE(0,33)-(310,34),f,b
GOSUB Zoomtaste
GOSUB Hcopytaste
GOSUB Gkselekttaste
GOSUB Selcleartaste
GOSUB Gkspnrtasten
GOSUB Gkspeichertaste
RESTORE Text1:FOR x=0 TO 8 STEP 2:LOCATE 6+x,2:READ b$:PRINT b$:NEXT
RESTORE Text2:FOR x=0 TO 5:LOCATE 6+x,38:READ b$:PRINT b$:NEXT
RESTORE Text3:FOR x=0 TO 4:LOCATE 13+x,38:READ b$:PRINT b$:NEXT
RESTORE Text4:FOR x=0 TO 1:LOCATE 16+x,2:READ b$:PRINT b$:NEXT
LOCATE 2,5:PRINT"Grafik vom "zeitstart$" bis "zeitende$
LOCATE 4,2:PRINT"Konto:":LOCATE 4,20:PRINT"Betrag:"
LOCATE 21:PRINT PTAB(7)"HCOPY";:PRINT PTAB(269)"ZOOM";
LOCATE 12,5:PRINT"Bitte Geduld ich suche Daten !"
GOSUB Bildein
ERASE kges:DIM kges(90):gesamt=0:kmax=0:zkmax=0
FOR x%=1 TO anzahl%
d$= MID$(ds$(x%),4,8)
IF zeitstart$=<d$ AND zeitende$>=d$ THEN
y%=VAL(LEFT$(ds$(x%),2))
w=VAL(RIGHT$(ds$(x%),10)):kges(y%)=kges(y%)+w
gesamt=gesamt+w
END IF
NEXT x%
IF gesamt=0 THEN
CLS:grafikaktiv%=0
fehlertext$="Habe keine Daten gefunden !"
GOTO Fehlermeldung
END IF
FOR x%=30 TO 70 STEP 10
FOR y%=2 TO 6
kges(x%)=kges(x%+y%)+kges(x%)
NEXT
IF ABS(kges(x%))>=ABS(zkmax) THEN zkmax=ABS(kges(x%))
NEXT
Grafikrefresh:
LINE(21,35)-(290,153),0,bf:LINE(51,154)-(259,173),0,bf
LINE(2,139)-(21,153),0,bf:LINE(259,139)-(309,153),0,bf
IF kgselekt%=1 THEN GOSUB Saeulenmaske:RETURN
IF zoom%=0 THEN GOSUB Unzoom
IF zoom%>0 THEN GOSUB Zoomen
GOSUB Saeulenmaske
RETURN
Gkspnrtasten:
FOR y%=1 TO 5 :y0=y%*16-16:y1=y0+14
FOR x=0 TO 1:LINE(3+x,36+x+y0)-(20-x,36-x+y1),f-(spsel%(y%)*3),b:NEXT x,y%
RETURN
Gkspeichertaste:
LINE(3,116)-(20,138),f-gksp%*3,b:LINE(4,117)-(19,137),f-gksp%*3,b
RETURN
Selcleartaste:
LINE(291,92)-(308,138),f-spselclr%*3,b:LINE(292,93)-(307,137),f-spselclr%*3,b
RETURN
Gkselekttaste:
LINE(291,36)-(308,90),f-sele%*3,b:LINE(292,37)-(307,89),f-sele%*3,b
RETURN
Hcopytaste:
LINE(3,155)-(50,172),f-hcop%*3,b:LINE(4,156)-(49,171),f-hcop%*3,b
RETURN
Zoomtaste:
LINE(260,155)-(308,172),f-zoomt%*3,b:LINE(261,156)-(307,171),f-zoomt%*3,b
RETURN
Zoomswitch:
sele%=0:GOSUB Gkselekttaste
kgselekt%=0
IF zoom%=0 THEN zoom%=zoomsel%+1:ELSE zoom%=0
GOSUB Grafikrefresh
RETURN
Kselektswitch:
zoom%=6
sele%=0:GOSUB Gkselekttaste
kgselekt%=1-kgselekt%
IF kgselekt%=0 THEN zoom%=0:GOSUB Grafikrefresh:RETURN
IF kgselekt%=1 THEN
sele%=1:GOSUB Gkselekttaste
kmax=0:FOR x%=1 TO 5
IF ABS(kges(81+x%))>=kmax THEN
kmax=ABS(kges(81+x%))
END IF
NEXT
FOR x%=1 TO 5
IF kmax<>0 THEN
shp%(x%)=INT(kges(81+x%)/kmax*80)
ELSE
shp%(x%)=0
END IF
IF kges(81+x%)<>0 AND shp%(x%)=0 THEN shp%(x%)=1
NEXT
GOSUB Grafikrefresh
END IF
RETURN
Zoomen:
zoomt%=1:GOSUB Zoomtaste
kmax=0
FOR x%=1 TO 5
IF ABS(kges((zoom%+2)*10+1+x%))>=kmax THEN
kmax=ABS(kges((zoom%+2)*10+1+x%))
END IF
NEXT
FOR x%=1 TO 5:shp%(x%)=0
IF kmax<>0 THEN shp%(x%)=INT(kges((zoom%+2)*10+1+x%)/kmax*80)
IF kges((zoom%+2)*10+1+x%)<>0 AND shp%(x%)=0 THEN shp%(x%)=1
NEXT
RETURN
Unzoom:
zoomt%=0:GOSUB Zoomtaste
FOR x=1 TO 5:shp%(x)=INT(kges((x+2)*10)/zkmax*80)
IF kges((x+2)*10)<>0 AND shp%(x)=0 THEN shp%(x)=1
NEXT
RETURN
Grafikselekt:
WINDOW 2:dummy=MOUSE(0)
gx%=MOUSE(1):gy%=MOUSE(2)
IF gx%<50 AND gy%>156 THEN Grafikprint
IF gx%>270 AND gy%>156 THEN Zoomswitch
IF gx%>30 AND gx%<290 AND gy%>50 THEN Saeulenselekt
IF gx%<20 AND gy%>36 AND gy%<138 THEN Kselektspeicher
IF gx%>290 THEN
IF gy%>36 AND gy%<91 THEN Kselektswitch
IF gy%>91 AND gy%<138 THEN Selektclear
END IF
RETURN
Selektclear1:
kges(81+ksspnume%)=0:m$(8,ksspnume%+1)="":shp%(ksspnume%)=0
spsel%(ksspnume%)=0:GOSUB Gkspnrtasten
RETURN
Selektclear:
spselclr%=1:GOSUB Selcleartaste
FOR x=80 TO 88:kges(x)=0:NEXT:FOR x=0 TO 6:m$(8,x)="":NEXT
FOR x%=1 TO 5:spsel%(x%)=0:GOSUB Gkspnrtasten:shp%(x%)=0:NEXT
GOSUB Grafikrefresh
spselclr%=0:GOSUB Selcleartaste
RETURN
Kselektspeicher:
ksspnum%=(gy%-28)/16
IF ksspnum%<6 THEN ksspnume%=ksspnum%
IF ksspnum%>5 THEN
gksp%=1:GOSUB Gkspeichertaste
GOSUB Selektclear1
gksp%=0:GOSUB Gkspeichertaste
END IF
IF zoom%=0 THEN
kges(81+ksspnum%)=kges((zoomsel%+3)*10)
m$(8,1+ksspnum%)=m$((zoomsel%+3),1)
ELSE
kges(81+ksspnum%)=kges((zoom%+2)*10+zoomsel%+2)
m$(8,1+ksspnum%)=m$((zoom%+2),zoomsel%+2)
END IF
spsel%(ksspnum%)=1:GOSUB Gkspnrtasten
zoomsel%=ksspnum%-1
zoomret%=zoom%:zoom%=6
GOSUB Saeulenselprint
zoom%=zoomret%
RETURN
Saeulenselekt:
zoomsel%=INT(gx%-5)/51-1
Saeulenselprint:
COLOR 4,0
IF zoom%=0 THEN
LOCATE 4,9:PRINT SPACE$(11)
LOCATE 4,9:PRINT m$(zoomsel%+3,0)
LOCATE 4,27:PRINT SPACE$(11)
LOCATE 4,27:PRINT USING "########.##";kges((zoomsel%+3)*10)
ELSE
LOCATE 4,9:PRINT SPACE$(11)
LOCATE 4,9:PRINT m$(zoom%+2,zoomsel%+2)
LOCATE 4,27:PRINT SPACE$(11)
LOCATE 4,27:PRINT USING "########.##";kges((zoom%+2)*10+zoomsel%+2)
END IF
RETURN
Saeulenmaske:
yy%=4:FOR xx%=0 TO 204 STEP 102:GOSUB Grafschild0:NEXT
yy%=20:FOR xx%=51 TO 153 STEP 102:GOSUB Grafschild0:NEXT
xx%=0 :FOR x%=1 TO 5:sh%=shp%(x%):GOSUB KontoSaeulen :xx%=xx%+51:NEXT
hcf%=4
Saeulentext:
FOR x%=1 TO 5
IF zoom%=0 THEN
schild$(x%)=m$(x%+2,0)
ELSE
schild$(x%)=m$(zoomsel%+3,x%+1)
END IF
IF zoom%=6 THEN schild$(x%)=m$(8,1+x%)
NEXT
z2=0:FOR x%=1 TO 5
LOCATE 19+z2,1:COLOR hcf%,2
PRINT PTAB(51*x%-(LEN(schild$(x%))*4))schild$(x%);
IF z2=0 THEN z2=2 :ELSE z2=0
NEXT
RETURN
Grafschild0:
LINE(8+xx%,136+yy%)-(98+xx%,148+yy%),4,b
LINE(7+xx%,137+yy%)-(97+xx%,149+yy%),2,bf
LINE(51+xx%,132)-(53+xx%,137+yy%),2,bf
LINE(54+xx%,133)-(54+xx%,136+yy%),4
LINE(32+xx%,131)-(70+xx%,132),3,b
LINE(33+xx%,130)-(38+xx%,125),3
LINE(71+xx%,130)-(76+xx%,125),3
LINE(71+xx%,131)-(76+xx%,126),3
LINE(38+xx%,125)-(76+xx%,125),3
PAINT(43+xx%,127),4,3
RETURN
KontoSaeulen:
IF sh%<0 THEN sh%=ABS(sh%):zf=3 :ELSE zf=0
topp%=131-sh%:IF sh%=0 THEN RETURN
LINE(32+xx%,130)-(70+xx%,110),0,bf
LINE(32+xx%,130)-(70+xx%,topp%),5-zf,bf
LINE(33+xx%,topp%-1)-(38+xx%,topp%-6),6-zf
LINE(71+xx%,topp%-1)-(76+xx%,topp%-6),6-zf
LINE(38+xx%,topp%-6)-(76+xx%,topp%-6),6-zf
LINE(33+xx%,topp%-1)-(70+xx%,topp%-1),6-zf
PAINT(50+xx%,topp%-3),6-zf
LINE(71+xx%,129)-(76+xx%,124),7-zf
LINE(71+xx%,topp%-1)-(76+xx%,topp%-6),7-zf
LINE(71+xx%,129)-(71+xx%,topp%-1),7-zf
LINE(76+xx%,124)-(76+xx%,topp%-6),7-zf
IF sh%=1 THEN RETURN
PAINT(73+xx%,topp%-2),7-zf
RETURN
Grafikprint:
hcop%=1:GOSUB Hcopytaste
sWindow& = WINDOW(7)
sScreen& = PEEKL(sWindow& + 46)
sViewPort& = sScreen& + 44
sRastPort& = sScreen& + 84
sColorMap& = PEEKL(sViewPort& + 4)
maxWidth% = PEEKW(sScreen& + 12)
maxHeight% = PEEKW(sScreen& + 14)
viewModes% = PEEKW(sViewPort& + 32)
command% = 11
srcX% = 3
srcY% = 11
srcWidth% = maxWidth%-6
srcHeight% = maxHeight%-14
destRows& = 0
destCols& = 0
special% = &H84
sigBit% = AllocSignal%(-1)
ClearPublic& = 65537&
msgPort& = AllocMem&(40,ClearPublic&)
POKE(msgPort& + 8), 4
POKE(msgPort& + 9), 0
portName$ = "MyPrtPort"+CHR$(0)
POKEL(msgPort& + 10), SADD(portName$)
POKE(msgPort& + 14), 0
POKE(msgPort& + 15), sigBit%
sigTask& = FindTask&(0)
POKEL(msgPort& + 16), sigTask&
CALL AddPort(msgPort&)
ioRequest& = AllocMem&(64,ClearPublic&)
POKE(ioRequest& + 8),5
POKE(ioRequest& + 9),0
POKEL(ioRequest& + 14), msgPort&
devName$ = "printer.device"+CHR$(0)
IF FRE(-1)<30000& THEN
GOSUB Outoffmem:hcop%=0:GOSUB Hcopytaste:RETURN
END IF
pError& = OpenDevice&(SADD(devName$),0,ioRequest&,0)
IF pError& <> 0 THEN
fehlertext$="Drucker nicht ansprechbar."
hcop%=0:GOSUB Hcopytaste
GOSUB Fehlermeldung
GOSUB Windowclose3
GOTO Cleanup2
END IF
POKEW(ioRequest& + 28), command%
POKEL(ioRequest& + 32), sRastPort&
POKEL(ioRequest& + 36), sColorMap&
POKEL(ioRequest& + 40), viewModes%
POKEW(ioRequest& + 44), srcX%
POKEW(ioRequest& + 46), srcY%
POKEW(ioRequest& + 48), srcWidth%
POKEW(ioRequest& + 50), srcHeight%
POKEL(ioRequest& + 52), destCols&
POKEL(ioRequest& + 56), destRows&
POKEW(ioRequest& + 60), special%
hcf%=0:GOSUB Saeulentext
ioError& = DoIO&(ioRequest&)
hcf%=4:GOSUB Saeulentext
IF ioError& <> 0 THEN
fehlertext$="Problem beim Drucken. Hardcopy abgebrochen !"
hcop%=0:GOSUB Hcopytaste
GOSUB Fehlermeldung
GOSUB Windowclose3
END IF
CALL CloseDevice(ioRequest&)
Cleanup2:
POKE(ioRequest& + 8), &HFF
POKEL(ioRequest& + 20), -1
POKEL(ioRequest& + 24), -1
CALL FreeMem(ioRequest&,64)
CALL RemPort(msgPort&)
POKE(msgPort& + 8), &HFF
POKEL(msgPort& + 20), -1
CALL FreeSignal(sigBit%)
CALL FreeMem(msgPort&,40)
hcop%=0:GOSUB Hcopytaste
RETURN
Tabprint:
MOUSE OFF
FOR x%=3 TO 7 :m%(x%,0)=m%(x%,1) :NEXT
IF tabaktuell=0 THEN
fehlertext$="Bitte vor Ausdruck Tabelle aktualisieren !":GOTO Fehlermeldung
END IF
IF z%=0 THEN
fehlertext$="Keine Daten zum Drucken vorhanden !":GOTO Fehlermeldung
END IF
printakt%=1:GOSUB Bildaus
CLS
IF sortflag%=0 THEN smodus$="sortiert nach Konten"
IF sortflag%=1 THEN smodus$="sortiert nach Datum"
IF detailflag%=1 THEN prtmodus$="detailiert"
IF gesamtflag%=1 THEN prtmodus$="im Gesamten":smodus$=""
IF filterflag%=1 THEN prtmodus$="gefiltert"
IF monatflag%=1 THEN prtmodus$="als Monatsabrechnung":smodus$=""
LOCATE 2,7:PRINT"Es werden die Eintragungen der markierten Konten "smodus$
FOR x%=3 TO 7:y%=0:LOCATE 4,(x%-3)*13+10:GOSUB Markieren1: NEXT x%
FOR y%=2 TO 6
FOR x%=3 TO 7 :LOCATE y%+4,10+(x%-3)*13:GOSUB Markieren1: NEXT x%
COLOR 1
NEXT y%
LOCATE 12,9
PRINT "In der Zeit von "zeitstart$" bis "zeitende$" "prtmodus$" ausgedruckt !"
LOCATE 14,5:PRINT"Datum (JJ-MM-TT):"
LOCATE 14,32:PRINT"Kommentar:"
GOSUB Bildein
LOCATE 14,22:laenge=8:msgs$=pdatum$:GOSUB Superinput: pdatum$=msgs$
LOCATE 14,42:laenge=34:msgs$=pkom$:GOSUB Superinput: pkom$=msgs$
ttextrl=18:ttextrp=28:ttextfl=18:ttextfp=45:GOSUB Bestaetigung
mousep%=9:RETURN
Mp9:
mousep%=0
IF fehler=1 THEN
printakt%=0:GOSUB Tabmaske:GOTO Tabausgabe
END IF
operationstext$="Drucker arbeitet : Abbruch durch (ESC)"
flag=1:GOSUB Operationsmeldung
pagenr= INT((z%-41)/60)+2
pagel%=72
pagec=1
plr%=10 :prr%=plr%+86
IF FRE(-1)<30000& THEN
GOSUB Outoffmem:GOSUB Windowclose3
printakt%=0:GOSUB Tabmaske:GOTO Tabausgabe
END IF
OPEN "prt:" FOR OUTPUT AS #1
PRINT #1,CHR$(27)"c";
PRINT #1,CHR$(27)"#1";
PRINT #1,CHR$(27)"[1z";
PRINT #1,CHR$(27)"[";pagel%;"t";
PRINT #1,CHR$(27)"[2w";
PRINT #1,CHR$(27)"(K";
PRINT #1,CHR$(27)"[6w";
PRINT #1,CHR$(27)"[1m";
PRINT #1,CHR$(27)"[2"CHR$(34)"z";
PRINT #1,CHR$(27)"[4m"
PRINT #1,"Auflistung der Tabelle nach Konten und Zeit"
PRINT #1,CHR$(27)"[24m";
PRINT #1,CHR$(27)"[5w";
PRINT #1,CHR$(13)
PRINT #1,"Tabelle vom ";
PRINT #1,USING "\ \";pdatum$;:PRINT #1," ";
PRINT #1,USING "\ \";pkom$;
PRINT #1,"Seite 1 von"pagenr
GOSUB Strich
PRINT #1,"Es werden die Eintragungen der markierten Konten "smodus$
PRINT #1,CHR$(13)
FOR x%=3 TO 7 :y%=0: GOSUB Markieren :NEXT
PRINT #1,CHR$(13)
GOSUB Strich
FOR y%=2 TO 6
FOR x%=3 TO 7 :GOSUB Markieren
NEXT x%
PRINT #1,CHR$(13)
NEXT y%
GOSUB Strich
PRINT #1,"In der Zeit von "zeitstart$" bis einschließlich "zeitende$" "prtmodus$" ausgedruckt !"
GOSUB Strich
PRINT #1,CHR$(27)"[22m";
x%=0
WHILE x%<z%
x%=x%+1
FOR v%=41 TO datenmenge+200 STEP 60
IF x%=v% THEN GOSUB Umblaettern
NEXT
PRINT #1,USING "###";x%;:PRINT #1," ";
IF gesamtakt%=0 THEN
PRINT #1,USING "\ \";MID$(ds$(show%(x%)),3,LEN(ds$(show%(x%)))-12);
IF VAL(RIGHT$(ds$(show%(x%)),10))<>0 THEN
PRINT #1,USING "#######.##";VAL(RIGHT$(ds$(show%(x%)),10));
END IF
ELSE
PRINT #1,USING "\ \";MID$(show$(x%),3,LEN(show$(x%))-12);
IF VAL(RIGHT$(show$(x%),10))<>0 THEN
PRINT #1,USING "#######.##";VAL(RIGHT$(show$(x%),10));
END IF
END IF
PRINT #1,CHR$(13)
IF INKEY$=CHR$(27) THEN Abbruch
WEND
GOSUB Strich
PRINT #1,"Im Gesamten wurden für die gewählten Konten laut Zeitmaske ";
PRINT #1,CHR$(27)"[1m";
PRINT #1,USING "########.##";gesamtbe;
PRINT #1,CHR$(27)"[22m";
PRINT #1," "waehrung$" aufgewendet !"
GOSUB Strich
GOSUB Seitenumbruch
CLOSE #1
operationstext$="Druckoperation fertig !":GOSUB Operationsmeldung
printakt%=0:GOSUB Tabmaske:GOTO Tabausgabe
Markieren:
IF m%(x%,y%)=1 THEN
mp$(x%,y%)="* "+m$(x%,y%)
PRINT #1,CHR$(27)"[1m";
ELSE
mp$(x%,y%)=" "+m$(x%,y%)
PRINT #1,CHR$(27)"[22m";
END IF
PRINT #1,USING "\ \" ;mp$(x%,y%);
RETURN
Markieren1:
IF m%(x%,y%)=1 THEN
COLOR 2
ELSE
COLOR 1
END IF
CALL Text (WINDOW(8),SADD(m$(x%,y%)),LEN(m$(x%,y%)))
RETURN
Abbruch:
CLOSE #1
fehlertext$="Druckoperation abgebrochen !":GOSUB Fehlermeldung
printakt%=0:GOSUB Tabmaske:tabaktiv=0:GOTO Tabausgabe
Strich:
FOR y%=1 TO 87:PRINT #1,"_";:NEXT:PRINT #1,CHR$(13):PRINT #1,CHR$(13)
RETURN
Umblaettern:
IF z%=40+(60*(pagenr-1)) THEN RETURN
GOSUB Strich :pagec=pagec+1
PRINT #1,CHR$(27)"[1m";
FOR y%=1 TO 5:PRINT #1,CHR$(13):NEXT
GOSUB Strich
PRINT #1,"Tabelle vom ";
PRINT #1,USING "\ \";pdatum$;
PRINT #1," ";
PRINT #1,USING "\ \";pkom$;
PRINT #1," (Fortsetzung) Seite ";
PRINT #1,USING "##";pagec;
GOSUB Strich
PRINT #1,CHR$(27)"[22m";
RETURN
Seitenumbruch:
vz%= (pagenr*60+5-z%)-20:IF pagenr=1 THEN vz%=45-z%
FOR y%=1 TO vz% :PRINT #1,CHR$(27)"d":NEXT
RETURN
Bubblesort:
sortlg%=INT(anzahl%/2)+1:sortrg%=anzahl%
Loop1:
IF sortrg%<=1 THEN GOTO Windowclose3
Loop2:
IF sortlg%<=1 THEN Loop3
sortlg%=sortlg%-1
sorti%=sortlg%:GOTO Loop4
Loop3:
SWAP ds$(1),ds$(sortrg%)
sortrg%=sortrg%-1
sorti%=1
Loop4:
sortx$=ds$(sorti%)
sortp%=0
Loop5:
IF 2*sorti%<=sortrg% AND sortp%=0 THEN Loop6
ds$(sorti%)=sortx$
GOTO Loop1
Loop6:
sortj%=2*sorti%
IF sortj%<sortrg% THEN
IF MID$(ds$(sortj%),4,8)<MID$(ds$(sortj%+1),4,8) THEN sortj%=sortj%+1
END IF
IF MID$(sortx$,4,8)>=MID$(ds$(sortj%),4,8) THEN Loop7
ds$(sorti%)=ds$(sortj%)
sorti%=sortj%:GOTO Loop5
Loop7:
sortp%=1:GOTO Loop5
Variablendim:
DIM m$(8,8)
DIM monat$(12)
DIM kontoart$(8,8)
DIM hilfefile$(2,15)
DIM mp$(7,7),ma%(7)
DIM m%(7,15)
DIM koliste%(30)
DIM koliste$(30)
DIM knum$(30)
DIM kges(88)
DIM gges(88)
DIM mges(1,12)
DIM balken%(310)
DIM c%(64),cs%(64)
DIM dsmem$(50)
DIM show$(26)
datenmenge=INT((FRE(0)-5000)/108)
IF datenmenge>999 THEN datenmenge=999
DIM ds$(datenmenge),show%(datenmenge)
DIM calc%(datenmenge)
DIM sortlg%(datenmenge)
DIM sortrg%(datenmenge)
RETURN
Datalesen:
RESTORE Monatsnamen
FOR x%=1 TO 12:READ monat$(x%)
NEXT
RESTORE Wochentage
FOR x%=0 TO 6:READ wt$(x%)
NEXT
RESTORE Hilfefiledatas
FOR y%=0 TO 1:FOR x%=0 TO 14
READ hilfefile$(y%,x%)
NEXT x%,y%
RETURN
Farbeinstellung:
RESTORE Farben
FOR x%=0 TO 7:READ r(x%),g(x%),b(x%):PALETTE x%,r(x%),g(x%),b(x%):NEXT
RETURN
Hilfefiledatas:
DATA Konten,Eingeben,Eingaben ändern,Zeitmaske
DATA Datum ändern,Filtertext,Währung,Dateien
DATA Kontenlisten,Sortieren,Importieren
DATA Exportieren,,,,,Tabelle Bildschirm,Tabelle Drucken,
DATA Alle Konten,Gesamt,Detailiert,Filter
DATA Sort.n.Konten,Sort.n.Datum,Monatsabrechnung,Grafikausgabe
DATA Selektieren,Selektinvert,Selektloeschen
Farben:
DATA 0,0,0,1,1,1,1,.2,.2,1,.7,.2,1,1,0,.3,.3,1,.7,.7,1,.5,.5,1
Wochentage:
DATA "Montag ","Dienstag ","Mittwoch ","Donnerstag"
DATA "Freitag ","Samstag ","Sonntag "
Monatsnamen:
DATA "Jänner ","Februar ","März ","April ","Mai ","Juni "
DATA "Juli ","August ","September","Oktober ","November ","Dezember "
Windowclose3:
WINDOW CLOSE 3:WINDOW 1
RETURN
Datenein:
CLOSE #2:diskfehler=0
header$=ds$(0)
OPEN dateiname$ FOR INPUT AS #2
INPUT#2,ds$(0)
IF LEFT$(ds$(0),2)="00" THEN Weiter10
fehlertext$="Die Datei hat eine falsche Datenstruktur !"
diskfehler=4:dateiname$=altdn$:ds$(0)=header$
CLOSE #2:GOTO Fehlermeldung
Weiter10:
ERASE m%,show%,show$:DIM m%(7,15),show%(datenmenge),show$(30)
GOSUB Systemsetsave
dzeitstart$=MID$(ds$(0),4,8):dzeitende$=MID$(ds$(0),13,8)
IF zeitstart$<dzeitstart$ OR zeitende$>dzeitende$ THEN
zeitstart$=dzeitstart$:zeitende$=dzeitende$
END IF
d0zeitstart$=dzeitstart$:d0zeitende$=dzeitende$
Kontenliste$=RIGHT$(ds$(0),LEN(ds$(0))-21)
Importein:
IF eximfl<>1 THEN anzahl%=0
Loop12:
diskfehler=0
IF EOF(2) THEN Loop13
INPUT#2,ds$(anzahl%+1)
IF diskfehler>0 THEN
fehlertext$="Schadhafte Datenstruktur !"
diskfehler=0:eximfl=0:GOTO Fehlermeldung
END IF
anzahl%=anzahl%+1
IF anzahl%>datenmenge-1 THEN CLOSE #2:anzahl%=0:GOTO Datenueberlauf
GOTO Loop12
Loop13:
CLOSE #2
RETURN
Datenueberlauf:
IF eximfl=1 THEN anzahl%=altanzahl%
fehlertext$="Datei zu groß ! Daten einlesen abgebrochen !"
GOTO Fehlermeldung
Rueckschreiben:
MOUSE OFF:MENU OFF
CLOSE #2
diskfehler=0
OPEN dateiname$ FOR OUTPUT AS #2
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Rueckschreiben
PRINT #2,ds$(0)
x%=1
WHILE x%<=anzahl%
IF VAL(RIGHT$(ds$(x%),10))<>0 THEN PRINT #2,ds$(x%)
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Rueckschreiben
x%=x%+1
WEND
CLOSE #2
RETURN
Konteneinlesen:
ml%=0:diskfehler=0:CLOSE #2
OPEN Kontenliste$ FOR INPUT AS#2
INPUT#2,dummy$
IF dummy$<>"11" OR diskfehler=2 THEN Kolesefehler
ERASE m$,ma%,kontoart$:DIM m$(8,8),ma%(8),kontoart$(8,8)
FOR x%=3 TO 7
INPUT#2,ma%(x%)
FOR y%=0 TO ma%(x%)
INPUT#2,m$(x%,y%)
INPUT#2,kontoart$(x%,y%)
IF m$(x%,y%)<>"" THEN ml%=x%-2
NEXT y%,x%
CLOSE #2
RETURN
Kolesefehler:
CLOSE #2
fehlertext$="Kontenliste hat falsches Datenformat !"
GOTO Fehlermeldung
Kontensave:
operationstext$="Ich speichere nun die Kontenliste !"
flag=1:GOSUB Operationsmeldung
FOR x%=3 TO 7:FOR y%=0 TO 6
IF m$(x%,y%)<>"" THEN ma%(x%)=y%
NEXT y%,x%
CLOSE #2
diskfehler=0
OPEN Kontenliste$ FOR OUTPUT AS #2
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Kontensave
PRINT#2,"11"
FOR x%=3 TO 7
PRINT#2,ma%(x%)
FOR y%=0 TO ma%(x%)
PRINT#2,m$(x%,y%)
PRINT#2,kontoart$(x%,y%)
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Kontensave
NEXT y%,x%
CLOSE #2
GOTO Windowclose3
Systemsetsave:
diskfehler=0:CLOSE #3
OPEN "Haushaltssystem/Systemset" FOR OUTPUT AS#3
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Systemsetsave
PRINT #3,dateiname$
PRINT #3,Kontenliste$
PRINT #3,detailflag%,gesamtflag%,sortflag%
PRINT #3,waehrung$
PRINT #3,zeitstart$
PRINT #3,zeitende$
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Systemsetsave
CLOSE #3
RETURN
Systemsetload:
CLOSE #2:diskfehler=0
OPEN "Haushaltssystem/Systemset" FOR INPUT AS#2
IF diskfehler>0 THEN
fehlertext$="Oh weh. Mir fehlt mein SYSTEMSET File !"
GOSUB Fehlermeldung:RETURN
END IF
INPUT #2,dateiname$
INPUT #2,Kontenliste$
INPUT #2,detailflag%,gesamtflag%,sortflag%
INPUT #2,waehrung$
INPUT #2,zeitstart$
INPUT #2,zeitende$
CLOSE #2
RETURN
Systemset:
datum$=RIGHT$(DATE$,2)+"-"+LEFT$(DATE$,2)+"-"+MID$(DATE$,4,2)
zeitstart$="80-01-01"
dzeitstart$=zeitstart$
zeitende$="99-12-31"
dzeitende$=zeitende$
d0zeitstart$=zeitstart$
d0zeitende$=zeitende$
seitendruck=1
waehrung$="ÖS"
detailflag%=1
sortflag%=1
bildzeilen=16
dateienmax=20
kontenlmax=20
dateiname1$="Haushaltsdaten/"
RETURN
Import:
eximfl=1
GOTO Loopvor
Export:
eximfl=0
Loopvor:
IF eximfl=0 THEN WINDOW 3,"Daten exportieren:",(80,50)-(550,140),0,1
IF eximfl=1 THEN WINDOW 3,"Daten importieren:",(80,50)-(550,140),0,1
PALETTE 3,0,0,0
LOCATE 5,16:PRINT "Bitte Dateinamen eingeben !"
LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b
PAINT (55,51),3
PALETTE 3,r(3),g(3),b(3)
LOCATE 8,10:laenge=39:msgs$=dateiname1$:GOSUB Superinput:dateiname1$=msgs$
diskfehler=0
OPEN dateiname1$ FOR INPUT AS #2
CLOSE #2
IF diskfehler=0 THEN Dateivorhanden
IF eximfl=1 THEN
fehlertext$="Datei nicht vorhanden"
GOTO Fehlermeldung
END IF
WINDOW 3,"Dateien Exportieren:",(80,50)-(550,140),0,1
LOCATE 4,15:PRINT " Dateiname für Export frei."
LOCATE 6,15:PRINT "Wollen Sie nun exportieren ?"
fehler=3
ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung
mousep%=10:RETURN
Mp10:
mousep%=0
IF fehler=1 THEN Windowclose3
GOTO Exportieren
Dateivorhanden:
IF eximfl=0 THEN
WINDOW 3,"Daten exportieren:",(80,50)-(550,140),0,1
LOCATE 4,12:PRINT " Dateiname schon vorhanden."
LOCATE 6,12:PRINT "Wollen Sie diese Datei überschreiben ?"
END IF
IF eximfl=1 THEN
WINDOW 3,"Daten Importieren:",(80,50)-(550,140),0,1
LOCATE 4,12:PRINT " Dateiname vorhanden."
LOCATE 6,12:PRINT " Wollen Sie diese Datei importieren ?"
END IF
fehler=3
ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung
mousep%=11:RETURN
Mp11:
mousep%=0
IF fehler=1 THEN GOTO Windowclose3
IF eximfl=0 THEN Exportieren
Importieren:
diskfehler=0
OPEN dateiname1$ FOR INPUT AS #2
IF diskfehler>0 THEN CLOSE #2:GOTO Fehlermeldung
INPUT#2,dummy$
IF LEFT$(dummy$,2)<>"22" THEN
fehlertext$="Datenformat falsch !!!!"
CLOSE #2:GOTO Fehlermeldung
END IF
IF dummy$<>"22 "+Kontenliste$ THEN
WINDOW 3,"Warnung:",(80,50)-(550,140),0,1
LOCATE 4,15:PRINT " Kontenlisten nicht gleich."
LOCATE 6,15:PRINT "Wollen Sie trotzdem importieren ?"
ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung
mousep%=12:RETURN
Mp12:
mousep%=0
IF fehler=1 THEN CLOSE#2:GOTO Windowclose3
END IF
CLS
LOCATE 4,14:PRINT " Sollen die Importierten Daten"
LOCATE 6,14:PRINT " in die Datei eingebunden werden ?"
ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung
mousep%=15:RETURN
Mp15:
mousep%=0
IF fehler=0 THEN fiximp%=1:ELSE:fiximp%=0
altanzahl%=anzahl%
GOSUB Importein:eximfl=0
IF fiximp%=1 THEN GOSUB Rueckschreiben
GOTO Windowclose3
Exportieren:
IF z%<1 THEN
fehlertext$="Keine Daten zum Exportieren vorhanden !"
GOTO Fehlermeldung
END IF
IF LEFT$(show$(1),2)="00" THEN
fehlertext$="Monatsabrechnungen können nicht exportiert werden!"
GOTO Fehlermeldung
END IF
diskfehler=0
OPEN dateiname1$ FOR OUTPUT AS #2
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Exportieren
IF diskfehler>0 THEN
CLOSE #2:GOTO Fehlermeldung
END IF
PRINT#2,"22 "Kontenliste$
FOR x%=1 TO z%
IF gesamtakt%=1 THEN
PRINT#2,show$(x%)
ELSE
PRINT#2,ds$(show%(x%))
END IF
IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Exportieren
NEXT x%
CLOSE #2
GOTO Windowclose3
Konten:
MENU OFF:MOUSE OFF
WINDOW 3,"Kontenlisten aktuallisieren:",(80,50)-(550,140),0,1
PALETTE 3,0,0,0
LOCATE 5,14:PRINT "Bitte Kontenlistenname eingeben !"
LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b
PAINT (55,51),3
PALETTE 3,r(3),g(3),b(3)
alkoli$=Kontenliste$
IF Kontenliste$="" THEN Kontenliste$="Haushaltskonten/"
LOCATE 8,10:laenge=39:msgs$=Kontenliste$:GOSUB Superinput
Kontenliste$=msgs$
diskfehler=0
OPEN Kontenliste$ FOR INPUT AS #2
CLOSE #2
IF diskfehler=0 THEN GOSUB Konteneinlesen:GOTO Kontenmaske
WINDOW 3,"Kontenlisten Aktuallisieren:",(80,50)-(550,140),0,1
LOCATE 4,9:PRINT "Ich habe diese Kontenliste nicht gefunden !"
LOCATE 6,9:PRINT "Wollen Sie diese Kontenliste neu erstellen ?"
fehler=3
ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:GOSUB Bestaetigung
mousep%=13:RETURN
Mp13:
mousep%=0
IF fehler=1 THEN Kontenliste$=alkoli$:GOTO Windowclose3
ERASE m$,ma%,kontoart$:DIM m$(8,6),ma%(8),kontoart$(8,6)
Kontenmaske:
GOSUB Windowclose3
kontenaktiv%=1
MOUSE ON :MENU OFF
GOSUB Bildaus
CLS
LINE(15,5)-(625,17),2,b
LOCATE 2,5:PRINT"Kontenliste :"
LOCATE 2,19:PRINT Kontenliste$
LINE(15,37)-(625,115),3,bf:LINE(15,21)-(625,35),3,bf
FOR x%=0 TO 4
LOCATE 4,x%*15+4:PRINT SPACE$(9)
LOCATE 4,x%*15+4:PRINT m$(x%+3,0)
NEXT
FOR x%=0 TO 4:FOR y%=1 TO 5
LOCATE y%*2+4,x%*15+4:PRINT SPACE$(10)
LOCATE y%*2+4,x%*15+4:PRINT m$(x%+3,y%+1)
LOCATE y%*2+4,x%*15+15:PRINT SPACE$(3)
LOCATE y%*2+4,x%*15+15:PRINT kontoart$(x%+3,y%+1)
NEXT y%,x%
FOR x%=1 TO 4
LINE(120*x%+19,21)-(120*x%+20,115),0,b
LINE(15,x%*16+36)-(625,x%*16+36),0,b
NEXT
ttextrl=18:ttextrp=28:ttextfl=18:ttextfp=45:GOSUB Bestaetigung
GOSUB Bildein
RETURN
Kontenmousecheck:
IF MOUSE(2)>115 THEN GOSUB Mouseposition:GOTO Kontentasten
IF MOUSE(1)<=20 OR MOUSE(1)>=625 THEN RETURN
IF MOUSE(2)<=20 THEN RETURN
xwert%=INT((MOUSE(1)-20)/120)
ywert%=INT((MOUSE(2)-20)/16)
MOUSE OFF
IF ywert%=0 THEN
LOCATE ywert%*2+4,xwert%*15+4:msgs$=m$(xwert%+3,ywert%):laenge=8
GOSUB Superinput:m$(xwert%+3,ywert%)=msgs$:m$(xwert%+3,ywert%+1)=msgs$
MOUSE ON:RETURN
END IF
LOCATE ywert%*2+4,xwert%*15+4:msgs$=m$(xwert%+3,ywert%+1):laenge=9
GOSUB Superinput:m$(xwert%+3,ywert%+1)=msgs$
Kontenart:
LOCATE ywert%*2+4,xwert%*15+15:msgs$=kontoart$(xwert%+3,ywert%+1):laenge=2
GOSUB Superinput:kontoart$(xwert%+3,ywert%+1)=msgs$
IF msgs$="+" OR msgs$="-" OR msgs$="-u" OR msgs$="+u" THEN Weiter11
kontoart$(xwert%+3,ywert%+1)="+":GOTO Kontenart
Weiter11:
MOUSE ON
RETURN
Kontentasten:
IF fehler=3 THEN RETURN
IF fehler=0 THEN GOSUB Kontensave
IF fehler=1 THEN Kontenliste$=alkoli$
operationstext$="Ich Aktuallisiere die Kontenliste !"
flag=1:GOSUB Operationsmeldung
GOSUB Konteneinlesen
GOSUB Machkonten
kontenaktiv%=0
tabaktiv=0
GOSUB Windowclose3
GOSUB Tabmaske
GOTO Tabausgabe
Openwindow3:
MENU OFF:MOUSE OFF
WINDOW 3,windowtext$,(80,50)-(550,140),0,1
RETURN
Autor:
windowtext$="Der Autor !!!!!!!!!!! ":GOSUB Openwindow3
CLS
LOCATE 2,25:PRINT"Sauer Franz"
LOCATE 3,20:PRINT"Senefeldergasse 58/28"
LOCATE 4,25:PRINT"A-1100 Wien"
LOCATE 5,13:PRINT"Tel. (Österreich) 0222 / 62 68 383"
LOCATE 7,7: PRINT"Sollten noch Fragen zum Programm auftreten so"
LOCATE 8,7: PRINT"richten Sie sich bitte an die oben angegebene"
LOCATE 9,7: PRINT"Adresse. Ich bin gerne bereit zu helfen. Ich "
LOCATE 10,7:PRINT"hoffe Sie können mein Programm nutzen."
fakt%=1
RETURN
Hilfe:
MOUSE OFF
WINDOW 3,"Hilfe !!!!!!!",(80,50)-(550,140),0,1
LOCATE 2,25:PRINT "Hilferoutine"
LOCATE 4,7:PRINT " Durch Anwählen eines Menüpunktes erhalten Sie"
LOCATE 5,7:PRINT "eine Ausführliche Beschreibung der jeweiligen"
LOCATE 6,7:PRINT "Funktion. Durch Drücken einer beliebigen Taste"
LOCATE 7,7:PRINT "blättern Sie nach vor.Durch 'Mouseclick' unter-"
LOCATE 8,7:PRINT "brechen Sie die Hilferoutine und kehren wieder"
LOCATE 9,7:PRINT "ins Hauptprogramm zurück. Wählen Sie nun bitte"
LOCATE 10,7:PRINT"einen Menüpunkt.
hilfeflag%=1
RETURN
Hilferoutine:
WHILE INKEY$<>"":WEND
hilfeflag%=0
IF leiste>2 THEN punkte=0:leiste=1
IF punkte>14 OR hilfefile$(leiste-1,punkte)="" THEN
fehlertext$="Dafür gibt es keinen Hilfetext !"
GOTO Fehlermeldung
END IF
diskfehler=0:CLOSE #2
OPEN "Hilfe/"+hilfefile$(leiste-1,punkte) FOR INPUT AS#2
IF diskfehler=0 THEN Hilfeladen
fehlertext$="Sorry, mir hat jemand das Hilfefile gestohlen !"
CLOSE #2
GOTO Fehlermeldung
Hilfeladen:
WINDOW 3,"Beschreibung für "+hilfefile$(leiste-1,punkte),(80,50)-(550,140),0,1
hzeile%=1:hlf%=1
Weiter13:
IF EOF(2) THEN Weiter14
LINE INPUT#2,zeighilfe$
IF hzeile%>9 THEN
mousep%=16
RETURN
Mp16:
mousep%=0
hzeile%=1:CLS
IF tdr=0 THEN Weiter15
END IF
hzeile%=hzeile%+1:hlaenge%=LEN(zeighilfe$)*8
LOCATE hzeile%,1
IF zeighilfe$<>"" THEN PRINT PTAB(240-hlaenge%/2)zeighilfe$
tdr=0:GOTO Weiter13
Weiter14:
mousep%=17
RETURN
Mp17:
mousep%=0
Weiter15:
hlf%=0:CLOSE #2
GOTO Windowclose3
Sysst:
windowtext$="Systemstatus:":GOSUB Openwindow3
LOCATE 2,2:PRINT "Aktuelle Datei :"dateiname$
LOCATE 3,2:PRINT "Aktuelle Kontenliste :"Kontenliste$
LOCATE 4,2:PRINT "Zeitbereich der Datei:"d0zeitstart$" bis "d0zeitende$
LOCATE 5,2:PRINT "Aktuelle Zeitmaske :"zeitstart$" bis "zeitende$
LOCATE 6,2:PRINT "--------------------------------------------------------"
LOCATE 7,2:PRINT "Dateigröße :"datenmenge" Verbraucht:"anzahl%" Frei:"datenmenge-anzahl%
LOCATE 8,2:PRINT "--------------------------------------------------------"
LOCATE 9,2:PRINT "Freie Bytes im Systemspeicher :"FRE(-1)
LOCATE 10,2:PRINT "Freie Bytes für Haushaltsdaten :"FRE(0)
fakt%=1
RETURN
Wae:
WINDOW 3,"Währungszeichen ändern:",(180,60)-(450,140),0,1
LOCATE 2,2:PRINT "Bitte Währungszeichen eingeben."
LINE (90,29)-(180,42),3,bf
LOCATE 5,16:PRINT SPACE$(3):msgs$=waehrung$:laenge=2
LOCATE 5,16:GOSUB Superinput:waehrung$=msgs$
ttextrl=8:ttextrp=9:ttextfl=8:ttextfp=22:GOSUB Bestaetigung
mousep%=14:RETURN
Mp14:
mousep%=0
IF fehler=1 THEN Windowclose3
WINDOW 1:LOCATE 21,58:PRINT "Gesamt "
LOCATE 21,65:PRINT waehrung$
GOSUB Systemsetsave
GOTO Windowclose3
Cursor:
LINE (0,0)-(7,7),2,bf
GET (0,0)-(7,7),c%
GET (0,0)-(1,7),cs%
LINE (0,0)-(7,7),0,bf
RETURN
Openlibrarys:
diskfehler=0
LIBRARY "graphics.library"
IF diskfehler>0 THEN
fehlertext$="Graphics Library nicht vorhanden !"
GOSUB Fehlermeldung:SYSTEM
END IF
LIBRARY "exec.library"
IF diskfehler>0 THEN
fehlertext$="Exec Library nicht vorhanden !"
GOSUB Fehlermeldung:SYSTEM
END IF
LIBRARY "intuition.library"
IF diskfehler>0 THEN
fehlertext$="Intuition Library nicht vorhanden !"
GOSUB Fehlermeldung:SYSTEM
END IF
RETURN
Mcp:
dummy=MOUSE(0):xpos%=MOUSE(3):ypos%=MOUSE(4)
IF xpos%>(offset%)*8 AND xpos%<(offset%+laenge)*8 THEN
IF ypos%>(y%-1)*8-3 AND ypos%<y%*8+3 THEN
mcpos%=INT((xpos%)/8)-offset%
END IF
END IF
RETURN
Editor:
ed%=1:
MOUSE ON
mcpos%=-1
max%=laenge
backup$=msgs$
y%=CSRLIN
offset%=POS(0)-1
mode%=1:bu%=0
x%=LEN(backup$):in$=""
ox%=LEN(prompt$)+1
IF type%=0 THEN
lo=32:hi=255:r1=lo:r2=hi
ELSEIF type%=1 THEN
lo=45:hi=57:r1=40:r2=43
END IF
LOCATE y%,1+offset%
PRINT prompt$;backup$
y%=CSRLIN-1
GOSUB Putc
WHILE in$<>CHR$(13)
in$=""
Loop25:
SLEEP
in$=INKEY$
IF in$<>"" OR mcpos%>=0 THEN Loop26
GOTO Loop25
Loop26:
IF mcpos%<0 THEN
bx%=x%
IF in$=CHR$(8) THEN '[BACKSPACE]
in$=""
wipe%=1
IF x%>0 THEN x%=x%-1
ELSEIF in$=CHR$(127) THEN '[DEL]
in$=""
wipe%=1
END IF
IF (in$>=CHR$(lo) AND in$<=CHR$(hi)) OR (in$>=CHR$(r1)AND in$<=CHR$(r2)) OR in$="" THEN
add$=LEFT$(backup$,x%)+in$
IF x%=LEN(backup$) THEN
backup$=add$
ELSEIF x%>LEN(backup$) THEN
diff%=x%-LEN(backup$)
backup$=backup$+SPACE$(diff%)+in$
ELSE
backup$=add$+RIGHT$(backup$,LEN(backup$)-x%-mode%)
END IF
IF wipe%=1 THEN
wipe%=0
ELSE
x%=x%+1
END IF
ELSEIF in$=CHR$(27) THEN '[INSERT]
SWAP mode%,bu%
ELSEIF in$=CHR$(31) THEN '[CSRLEFT]
IF x%>0 THEN
x%=x%-1
ELSE
BEEP
END IF
ELSEIF in$=CHR$(30) THEN '[CSRRIGHT]
x%=x%+1
END IF
IF bu%=0 THEN
PUT ((bx%+LEN(prompt$)+offset%)*8,(y%-1)*8),c%,XOR
ELSE
PUT ((bx%+LEN(prompt$)+offset%)*8,(y%-1)*8),cs%,XOR
END IF
IF type%=3 THEN
IF x%>0 THEN x%=x%-1
ELSEIF x%>max% THEN
x%=x%-1
BEEP
END IF
IF LEN(backup$)>max% THEN
backup$=LEFT$(backup$,max%)
BEEP
END IF
LOCATE y%,ox%+offset%
bu$=backup$+SPACE$(1)
CALL Text(WINDOW(8),SADD(bu$),LEN(bu$))
GOSUB Putc
ELSE
GOSUB Putc
x%=mcpos%:mcpos%=-1
GOSUB Putc
END IF
MOUSE ON
WEND
GOSUB Putc
msgs$=backup$
ed%=0
RETURN
Putc:
IF bu%=0 THEN
PUT ((x%+LEN(prompt$)+offset%)*8,(y%-1)*8),c%,XOR
ELSE
PUT ((x%+LEN(prompt$)+offset%)*8,(y%-1)*8),cs%,XOR
END IF
RETURN
RETURN
Guru:
alertnum&=0
res&=DisplayAlert&(alertnum&,SADD(errText1$),56)
GOTO Ende
Outoffmemtext:
errText1$=CHR$(0)+CHR$(96)+CHR$(20)+"Oh weh, oh weh, da ist ein schwerer Fehler aufgetreten !"
errText1$=errText1$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(72)+CHR$(30)+"Ich sehe mich daher leider gezwungen das Programm zu Beenden."
errText1$=errText1$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(168)+CHR$(40)+"Drücken Sie nun die linke Maustaste."
errText$=CHR$(0)+CHR$(96)+CHR$(20)+"Jetzt haben Sie es geschafft . Mir ist der Speicher"
errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(28)+"ausgegangen. Versuchen Sie eventuell geöffnete Fenster"
errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(36)+"zu schließen oder Programme die noch Speicher belegen"
errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(44)+"wegzuräumen . Sollte ich wieder mehr als 30000 Bytes"
errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(52)+"freien Systemspeicher vorfinden so können Sie mit viel"
errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(60)+"Glück ihre Arbeit fortsetzen."
errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(168)+CHR$(82)+"Drücken Sie nun die Linke Maustaste."
errText$=errText$+CHR$(0)
RETURN
Outoffmem:
alertnum&=0
res&=DisplayAlert&(alertnum&,SADD(errText$),100)
GOSUB Mouseclick
IF ERR=7 THEN RUN
RETURN
Screendown:
FOR x%=1 TO 28
sc&=PEEKL(WINDOW(7)+46)
CALL MoveScreen(sc&,0,10)
NEXT
RETURN
Screenup:
FOR x%=1 TO 28
sc&=PEEKL(WINDOW(7)+46)
CALL MoveScreen(sc&,0,-10)
NEXT
RETURN
Declarieren:
IF alreadydeclared = 0 THEN
DECLARE FUNCTION DisplayAlert& LIBRARY
DECLARE FUNCTION AllocSignal%() LIBRARY
DECLARE FUNCTION AllocMem&() LIBRARY
DECLARE FUNCTION FindTask&() LIBRARY
DECLARE FUNCTION DoIO&() LIBRARY
DECLARE FUNCTION OpenDevice& LIBRARY
alreadydeclared = 1
END IF
RETURN